Introduction

This report brings together information on different metrics for measuring the UK population’s perceptions of Climate Change, with the aim of providing a resource for policy makers to monitor the impact of Climate Change and associated policies on UK society.

Global Concern of Climate Change

Plots generated using the Lloyds Risk Poll data.

% threat is defined as seeing Climate Change as a very serious or somewhat serious threat to their country over the next 20 years.

Climate Change Concern by Age Group in North West Europe

Plots generated using the Lloyds Risk Poll data.

Attitudes Towards Climate Change

Plots generated using the Opinions and Lifestyle Survey (ONS) data.

Attitute towards future environment

Worries about Climate Change

p2 = ggplot(table2, aes(fill = opinion, y = percentage, x = region)) +
  geom_bar(position="stack", stat="identity") +
  theme_cowplot(12) + 
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1),
        plot.margin = margin(1.5,1,1,1.2, "cm")) +
  labs(y = "Percentage (%)", 
       x = "Region",
       fill = "") +
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  scale_fill_viridis_d(labels= function(x) stringr::str_wrap(x, width = 30),                         direction = -1) +
  ylim(c(0,100)) +
  ggtitle("How worried or unworried are you about the impact \nof climate change?") +
  geom_vline(xintercept=1.5, linetype="dashed", lwd = 1)

ggplotly(p2)

Anxiety over future environment

p3 = ggplot(table3, aes(fill = opinion, y = percentage, x = region)) +
  geom_bar(position="stack", stat="identity") +
  theme_cowplot(12) + 
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), 
        plot.margin = margin(1.5,1,1,1.2, "cm")) +
  labs(y = "Percentage (%)", 
       x = "Region",
       fill = "") +
    ylim(c(0,100)) +
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  scale_fill_viridis_d(labels= function(x) stringr::str_wrap(x, width = 30),                         direction = -1) +
  ggtitle("Over the past month how anxious, if at all, \nhave you felt about the future of the environment?") +
  geom_vline(xintercept=1.5, linetype="dashed", lwd = 1)

ggplotly(p3)

Effect of Demographics on Climate Change Perceptions

Logistic regression generated using Lloyds Risk Poll data.

### Logistic regression looking at predictors of perceiving climate change as a risk to country

## Set level orders/reference categories

LRP_UK <- LRP_UK %>% 
  mutate(AgeGroup = factor(AgeGroup, levels = c("15_29", "30_49", "50_64", "65_94")),
         education_level = factor(education_level, levels = c("Low", "Medium", "High")),
         Income_categories = factor(Income_categories, levels = c("Poorest 20%",
                                                                  "Second 20%",
                                                                  "Third 20%",
                                                                  "Fourth 20%",
                                                                  "Richest 20%")),
         Year = as.character(Year),
         Year = factor(Year, levels = c("2019", "2021")),
         Gender = as_factor(Gender),
         Urbanicity = as_factor(Urbanicity),
         HouseholdSize = factor(HouseholdSize, levels = c("1_2", "3_4", "5+")),
         ChildrenInHousehold = factor(ChildrenInHousehold, levels = c("No", "Yes")))


## Define model
my_model <- "climate_threat ~ AgeGroup + Gender + education_level + Income_categories + Urbanicity + HouseholdSize + ChildrenInHousehold + Year"

## Run model
threat.mod <- glm(my_model,
                  data = LRP_UK,
                  family = "binomial")



### Get ORs and CIs

threat_ORS <- exp(cbind(coef(threat.mod), confint.default(threat.mod)))


threat_ORS_fin <- data.frame(
  level = rownames(threat_ORS),
  OR = threat_ORS[,1],
  ll = threat_ORS[,2],
  ul = threat_ORS[,3],
  p = coef(summary(threat.mod))[, 4]
)


## Define variable info for plot

vars <- c("AgeGroup", "Gender", "education_level", "Income_categories", 
          "Urbanicity", "HouseholdSize", "ChildrenInHousehold", "Year")

refs <- c("AgeGroup15_29", "GenderFemale", "education_levelLow",
          "Income_categoriesPoorest 20%", "UrbanicityRural",
          "HouseholdSize1_2", "ChildrenInHouseholdsNo", "Year2019")

reference_categories <- data.frame(
  level = c("AgeGroup15_29", "GenderFemale", "education_levelLow",
            "Income_categoriesPoorest 20%", "UrbanicityRural",
            "HouseholdSize1_2", "ChildrenInHouseholdNo", "Year2019"),
  OR = 1
)


## seperate variables and levels and set level orders
threat_plot_data <- bind_rows(reference_categories, threat_ORS_fin) %>% 
  mutate(variable = str_extract(level, paste(vars, collapse = "|")),
         lev = str_remove_all(level, paste(vars, collapse = "|"))) %>% 
  filter(!is.na(variable))

level_ord <- c()

for(i in vars){
  
  lev <- levels(LRP_UK[, i])
  level_ord <- c(level_ord, lev)
}


level_ord <- str_replace_all(level_ord, "_", "-")

threat_plot_data <- threat_plot_data %>% 
  mutate(
    lev = str_replace_all(lev, "_", "-"),
    variable = str_replace_all(variable, "_", " "),
    #variable = tolower(variable),
    lev = factor(lev, levels = level_ord)) %>% 
  arrange(lev) 


### Plot

ggplot(threat_plot_data, aes(x = OR, y = lev, colour = variable)) +
  geom_point(size = 2) +
  scale_x_log10() +
  scale_color_brewer(palette = "Set2") +
  geom_errorbar(aes(xmin = ll, xmax = ul), width = 0.5) +
  geom_vline(xintercept = 1, colour = "black", linetype = "dashed") +
  labs(title = "How Climate Change Threat Perception Varies by Demographic in the UK") +
  theme_classic() +
  theme(axis.line.x = element_blank(), panel.grid.major.x = element_line(colour = "grey90", linetype = "dashed"), axis.ticks.x = element_blank(),
        legend.position = "none", strip.text.y = element_text(size = 7, angle = 0)) +
  ylab(NULL) +
  xlab("Odds Ratio") +
  facet_grid(rows = vars(variable), scales = "free", space = "free")


Results presented are odds ratios that show the relative increase in odds of perceiving climate change as a threat compared to the reference category, whilst holding the other included factors constant. An odds ratio of 2 indicates that someone with the given characteristic would be twice as likely to perceive climate change as a threat compared to the respective reference category, whilst an odds ratio of 0.5 would suggest someone is half as likely. Odds ratios are also presented with accompanying confidence intervals at the 95% level.

Public Support for Policy and Personal Changes

First 4 plots have been generated using the UK Department for Business, Energy and Industrial Strategy data, and the final plot has been generated using the Opinions and Lifestyle Survey (ONS) data.

Policies

Personal changes 1

### actions ######## 

actions <- beis_spreadsheet[[10]] %>% 
  select(A, B, H)

#################### Format data ##########################################

### Generate all tables as list

## Each table is indexed in the same way, every 15 lines - so loop through to get these (Do top 4 seperately as in different format)
table_seq <- seq(1, 46, by = 15) 

tables <- list()
iter <- 0

for (i in table_seq){
  
  iter <- iter + 1
  
  start <- i+4
  end <- i+10
  
  this_table <- actions[c(start:end),] %>% 
    select(support = B, perc = H) 
  
  this_table <- this_table %>% 
    mutate(support = factor(support, levels = unique(this_table$support)))
  
  tables[[iter]] <- this_table
  
}


### Create policy labels

category <- c("use a green energy supplier",
              "use a smart meter",
              "eat mainly plant-based meals",
              "minimise food waste")

### Add category to each table to allow easier labelling in plotly

for(i in 1:4){
  
  tables[[i]] <- tables[[i]] %>% 
    mutate(cat = category[i]) ### add var for category
  
}


#### Create headline statement of support

support <- c()

### Get % that support actions overall
for(i in tables){
  
  perc_support <- sum(as.numeric(i[c(1:3), 2])) ## take from top two rows of each columns
  perc_support <- round(100*perc_support, digits = 0)
  
  support <- c(support, perc_support)
}

## Make into a statement

statement <- c()

for(i in 1:length(tables)){
  
  this_statement <- paste0(support[i], "% at least 'somewhat likely' to ", category[i])
  statement <- c(statement, this_statement)
  
}

statement2 <- str_wrap(statement, width = 15)

### Set colours
my_colours <- c(viridis(6, direction = -1), "#888888") 


######################## Plot ###############################################

# Set grid coordinaetes for plots 
row <- c(0,0,
         1,1)
column <- c(0,1,
            0,1)



## Initiate plot_ly figure and set colours 

fig <- plot_ly(marker = list(colors = my_colours))

## set centres of each subplot
x_centres <- rep(c(2.1/9, 6.9/9), 2) ## This was done through trial and error, may need to adjust in markdown
y_centres <- c(rep(11.25/13, 2), rep(1.75/13, 2))


### Create each subplot
for(i in c(1:4)){
  
  fig <- fig %>% add_pie(data = tables[[i]], labels = ~support, values = ~perc, 
                         name = category[i],
                         textinfo = "none",
                         hoverinfo = "text",
                         text = ~ paste0(
                           '</br>', cat, 
                           '</br>', support, ": ", round(100*as.numeric(perc), 1), "%"),
                         domain = list(row = row[i], column = column[i]), hole = 0.6,
                         direction = "clockwise",
                         sort = FALSE) %>%
    add_annotations(x = x_centres[i],
                    y = y_centres[i],
                    text = statement2[i],
                    xref = "paper",
                    yref = "paper",
                    xanchor = "center",
                    yanchor = "center",
                    showarrow = FALSE,
                    font = list(family = "calibri", size = 11))
  #layout(annotations = list(text = statement[i]))
}

## Format
fig <- fig %>% layout(title = "Liklihood of making changes in the next 6 months", showlegend = T,
                      grid=list(rows=2, columns=2),
                      xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      legend = list(orientation = "h",
                                    xanchor = "center",
                                    x = 0.5))



## Final figure
fig

Personal changes 2

#### Repeating for actions now


## Each table is indexed in the same way, every 15 lines - so loop through to get these (Do top 4 seperately as in different format)
table_seq <- seq(1, 15, by = 14) 

tables <- list()
iter <- 0

for (i in table_seq){
  
  iter <- iter + 1
  
  start <- i+64
  end <- i+69
  
  this_table <- actions[c(start:end),] %>% 
    select(support = B, perc = H) 
  
  this_table <- this_table %>% 
    mutate(support = factor(support, levels = unique(this_table$support)))
  
  tables[[iter]] <- this_table
  
}


### Create policy labels

category <- c("use less heating",
              "reduce thermostat temperature")

### Add category to each table to allow easier labelling in plotly

for(i in 1:2){
  
  tables[[i]] <- tables[[i]] %>% 
    mutate(cat = category[i]) ### add var for category
  
}


#### Create headline statement of support

support <- c()

### Get % that support actions overall
for(i in tables){
  
  perc_support <- sum(as.numeric(i[c(1, 2), 2])) ## take from top two rows of each columns
  perc_support <- round(100*perc_support, digits = 0)
  
  support <- c(support, perc_support)
}

## Make into a statement

statement <- c()

for(i in 1:length(tables)){
  
  this_statement <- paste0(support[i], "% at least 'somewhat likely' to ", category[i])
  statement <- c(statement, this_statement)
  
}

statement2 <- str_wrap(statement, width = 15)

### Set colours
my_colours <- c(viridis(5, direction = -1), "#888888") 


######################## Plot ###############################################

# Set grid coordinaetes for plots 
row <- c(0,0)
column <- c(0,1)






## Initiate plot_ly figure and set colours 

fig <- plot_ly(marker = list(colors = my_colours))

## set centres of each subplot
x_centres <- rep(c(2.1/9, 6.9/9)) ## This was done through trial and error, may need to adjust in markdown
#y_centres <- c(rep(5/6, 2), rep(1/6, 2))


### Create each subplot
for(i in c(1:2)){
  
  fig <- fig %>% add_pie(data = tables[[i]], labels = ~support, values = ~perc, 
                         name = category[i],
                         textinfo = "none",
                         hoverinfo = "text",
                         text = ~ paste0(
                           '</br>', cat, 
                           '</br>', support, ": ", round(100*as.numeric(perc), 1), "%"),
                         domain = list(row = row[i], column = column[i]), hole = 0.6,
                         direction = "clockwise",
                         sort = FALSE) %>%
    add_annotations(x = x_centres[i],
                    y = 0.5,
                    text = statement2[i],
                    xref = "paper",
                    yref = "paper",
                    xanchor = "center",
                    yanchor = "center",
                    showarrow = FALSE,
                    font = list(family = "calibri", size = 13))
  #layout(annotations = list(text = statement[i]))
}

## Format
fig <- fig %>% layout(title = "Liklihood of making changes compared to last winter", showlegend = T,
                      grid=list(rows=1, columns=2),
                      xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      legend = list(orientation = "h",
                                    xanchor = "center",
                                    x = 0.5))



## Final figure
fig

Personal changes 3

table_seq <- seq(1, 31, by = 15) 

tables <- list()
iter <- 0

for (i in table_seq){
  
  iter <- iter + 1
  
  start <- i+92
  end <- i+98
  
  this_table <- actions[c(start:end),] %>% 
    select(support = B, perc = H) 
  
  this_table <- this_table %>% 
    mutate(support = factor(support, levels = unique(this_table$support)))
  
  tables[[iter]] <- this_table
  
}


### Create policy labels

category <- c("buy an electric car (instead of petrol/diesel)",
              "avoid travelling by plane",
              "switch to low-carbon heating technology")

### Add category to each table to allow easier labelling in plotly

for(i in 1:3){
  
  tables[[i]] <- tables[[i]] %>% 
    mutate(cat = category[i]) ### add var for category
  
}


#### Create headline statement of support

support <- c()

### Get % that support actions overall
for(i in tables){
  
  perc_support <- sum(as.numeric(i[c(1:3), 2])) ## take from top two rows of each columns
  perc_support <- round(100*perc_support, digits = 0)
  
  support <- c(support, perc_support)
}

## Make into a statement

statement <- c()

for(i in 1:length(tables)){
  
  this_statement <- paste0(support[i], "% at least 'somewhat likely' to ", category[i])
  statement <- c(statement, this_statement)
  
}

statement2 <- str_wrap(statement, width = 15)

### Set colours
my_colours <- c(viridis(6, direction = -1), "#888888") 


######################## Plot ###############################################

# Set grid coordinaetes for plots 
row <- c(0,0, 0)
column <- c(0,1,2)



## Initiate plot_ly figure and set colours 

fig <- plot_ly(marker = list(colors = my_colours))

## set centres of each subplot
x_centres <- c(2/13, 1/2, 11/13) ## This was done through trial and error, may need to adjust in markdown
y_centres <- 0.5


### Create each subplot
for(i in c(1:3)){
  
  fig <- fig %>% add_pie(data = tables[[i]], labels = ~support, values = ~perc, 
                         name = category[i],
                         textinfo = "none",
                         hoverinfo = "text",
                         text = ~ paste0(
                           '</br>', cat, 
                           '</br>', support, ": ", round(100*as.numeric(perc), 1), "%"),
                         domain = list(row = row[i], column = column[i]), hole = 0.6,
                         direction = "clockwise",
                         sort = FALSE) %>%
    add_annotations(x = x_centres[i],
                    y = y_centres[i],
                    text = statement2[i],
                    xref = "paper",
                    yref = "paper",
                    xanchor = "center",
                    yanchor = "center",
                    showarrow = FALSE,
                    font = list(family = "calibri", size = 11))
  #layout(annotations = list(text = statement[i]))
}

## Format
fig <- fig %>% layout(title = "Liklihood of making changes next time", showlegend = T,
                      grid=list(rows=1, columns=3),
                      xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      legend = list(orientation = "h",
                                    xanchor = "center",
                                    x = 0.5))



## Final figure
fig

Barriers to personal change

p4 = ggplot(table4, aes(fill = opinion, y = percentage, x = region)) +
  geom_bar(position="stack", stat="identity") +
  theme_cowplot(12) + 
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1), legend.position = "none",
        plot.margin = margin(4,1,1,1.2, "cm")) +
  labs(y = "Percentage (%)", 
       x = "Region",
       fill = "") +
  scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 10)) +
  scale_fill_viridis_d(labels= function(x) stringr::str_wrap(x, width = 30),                         direction = -1) +
  ggtitle("For what reasons have you not made any \nchanges to your lifestyle to tackle climate change?") +
  geom_vline(xintercept=1.5, linetype="dashed", lwd = 1) +
  facet_wrap(~opinion, ncol = 1)

ggplotly(p4)

References

  • ACLED Data on Global Protests: Data Export Tool - ACLED (acleddata.com)
  • BEIS Survey on Public Awareness and Perceptions of Climate Change: Climate change and net zero: public awareness and perceptions - GOV.UK (www.gov.uk)
  • Google Trends: https://trends.google.com/trends/?geo=GB,
  • Lloyds Risk Poll for Resilience from 2021: World Risk Poll Resilience Index - The Lloyd’s Register Foundation World Risk Poll (lrfoundation.org.uk)
  • Options and Lifestyle Survey (ONS): Data on public attitudes to the environment and the impact of climate change, Great Britain - Office for National Statistics (ons.gov.uk)
  • The Climate Change Twitter Dataset: The Climate Change Twitter Dataset | Kaggle
  • Twitter Follower Information: https://socialblade.com/